Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/v9n17.arc/PCBOOK.BAS

BASIC Source File | 1990-09-12 | 18KB | 467 lines

'PCBook.BAS
'Utility to print ASCII text files to LaserJet Series II, IIp or III
'   in booklet format
'
'Copyright 1990 PC Magazine - Ziff Davis - Jay Munro
'Written by Jay Munro
'===========================================================================
'LaserJet programming concepts employed:
'       Setting orientation & font style
'       Locating LaserJet cursor
'       LaserJet Macro setup and use
'===========================================================================
'General programming concepts
'       Building index arrays
'       Using files for printing
'
'Compiler syntax:
'    BC /o /x PCBook.BAS;
'    Link /ex PCBook;
'
DEFINT A-Z
DECLARE SUB BuildArray (PtrArray&(), Pgcount%)
DECLARE SUB DoMacro (Num$)                      'Execute Laserjet macro
DECLARE SUB EndMacro (Num$)                     'End of macro commands
DECLARE SUB Header (Page%)                      'Print Header
DECLARE SUB LJLocate (X%, Y%)                   'Laserjet cursor locate
DECLARE SUB PrintSetup ()                       'Set up macros, fonts
DECLARE SUB PrintLogo ()                        'Credits
DECLARE SUB StartMacro (Num$)                   'Start of macro commands

TYPE Flags                                      'Misc flag variables
  CurDate AS INTEGER
  DoHeader AS INTEGER
  FileTitle AS INTEGER
  LineLen AS INTEGER
  LineWrap AS INTEGER
  PgNumber AS INTEGER
END TYPE

'Share variables with subs

DIM SHARED ESC$, FF$, LF$, FileName$
DIM SHARED PC AS Flags

REDIM PtrArray&(513)                            'total number of pages (512)

ON ERROR GOTO ErrorDept                         'Error trapping

'============== Set some constant variables
 ESC$ = CHR$(27)                                'Standard ESC code
 FF$ = CHR$(12)                                 'Page Feed
 LF$ = CHR$(10)                                 'Line Feed
 OutFile$ = "LPT1"                              'printer port
 JustCount% = 0                                 'Pause after page count off
 Tune% = 0
 PC.LineLen = 80                                'Maximum length of line

 CLS
 CALL PrintLogo

'============== Setup from the command line
IF LEN(COMMAND$) THEN                           'do this only when command$ is used
   IF LEFT$(LTRIM$(COMMAND$), 1) <> "/" THEN
      IF INSTR(COMMAND$, "/") THEN
         FileName$ = MID$(LTRIM$(COMMAND$), 1, INSTR(LTRIM$(COMMAND$), " "))
      ELSE
         FileName$ = LTRIM$(COMMAND$)
      END IF
   END IF

   IF INSTR(COMMAND$, "/D") THEN
      PC.CurDate = -1                           'Do current date
      PC.DoHeader = -1
   END IF

   IF INSTR(COMMAND$, "/F") THEN
      PC.FileTitle = -1                         'Do file title
      PC.DoHeader = -1
   END IF

   IF INSTR(COMMAND$, "/P") THEN
      PC.PgNumber = -1                          'Do page numbers
      PC.DoHeader = -1
   END IF

   IF INSTR(COMMAND$, "/C") THEN
      JustCount% = -1                           'Just count pages
   END IF

   IF INSTR(COMMAND$, "/2") THEN                'Use LPT2
      OutFile$ = "Lpt2"
   END IF

   IF INSTR(COMMAND$, "/W") THEN                'Use linewrap
      PC.LineWrap = -1
   END IF

   IF INSTR(COMMAND$, "/S") THEN                'Use beep statements
      Tune% = -1
   END IF

   IF INSTR(COMMAND$, "/H") THEN                'Show help
      PRINT "Usage: PCBOOK filename [/F] [/P] [/D] [/C] [/2] [/A] [/W] [/S] [/H]"
      PRINT "/F - prints file name at top of page"
      PRINT "/P - prints page numbers"
      PRINT "/D - prints current date on every page"
      PRINT "/C - pauses after physical page count"
      PRINT "/2 - print to LPT2"
      PRINT "/A - prompt for alternate file to print to"
      PRINT "/W - set line wrap on"
      PRINT "/S - sound on"
      PRINT "/H - this help message"
      GOTO OutHere
    END IF
END IF

'============== Open text file

GetName:
    IF LEN(FileName$) = 0 THEN
       IF Tune% THEN BEEP
       LINE INPUT "Enter file name to print: "; FileName$
       PRINT
       IF FileName$ = "" THEN GOTO OutHere
    END IF                                      'Test if file is there
    OPEN FileName$ FOR INPUT AS #1              '    by forcing an error
    CLOSE #1                                    'BASIC 7 can use Dir$ instead

'============== Prompt for new output file if requested
   IF INSTR(COMMAND$, "/A") THEN                'Prompt for output file
      PRINT
      IF Tune% THEN BEEP
      LINE INPUT "Enter alternate output file: "; Temp$
      IF Temp$ <> "" THEN OutFile$ = Temp$      'allow a change of mind
      PRINT
   END IF

'============== Build index array for pages in FileName$
   PRINT "Reading file "; FileName$
   CALL BuildArray(PtrArray&(), Page%)          'Built pointer array

'============== Figure number of pages needed
   IF Page% MOD 4 THEN                          'Even multiples of 4 only
      Page% = Page% + (4 - Page% MOD 4)         '  correct for less
   END IF

   PRINT
   PRINT "You will print "; Page% \ 4; "sheets" 'Report total number of pages
   PRINT

   IF JustCount% THEN
      PRINT "Press any key to continue, or ESC to cancel printing"
      GOSUB KeyIn
   END IF

   OPEN OutFile$ FOR OUTPUT AS #2               'Open printer or output file
   CALL PrintSetup                              'Set up printer

'Page parsing variables
   LeftSide% = Page%
   RightSide% = 1
   FirstPass% = -1

OPEN FileName$ FOR BINARY AS #1                 'Open the input file
   PRINT "Printing Side 1 to "; OutFile$;       'Track what is going on

'============== Start of print routine

DoPass:
   Bookmark% = (Page% \ 4)                      'Flag for halfway through
   IF Bookmark% = 0 THEN Bookmark% = 1          'Force 1 if too small

'============== Read text and send to printer
DO                                              'Print the right side of the page first
    IF PtrArray&(RightSide% + 1) = 0 THEN       'If blank, then skip it
       GOTO NextPage
    END IF
    CALL DoMacro("2")                           'Start on right side
    LJLocate 95, 0                              'Home the cursor

    IF PC.DoHeader THEN CALL Header(RightSide%) 'Header if needed
    Buffer$ = SPACE$(PtrArray&(RightSide% + 1) - PtrArray&(RightSide%))

    GET #1, PtrArray&(RightSide%), Buffer$      'Read in a page

    IF INSTR(Buffer$, FF$) THEN                 'If the last character is a PF
       PRINT #2, LEFT$(Buffer$, INSTR(Buffer$, FF$) - 1); 'print only text
    ELSE
       PRINT #2, Buffer$;                       'Otherwise print full line
    END IF

NextPage:
    IF PtrArray&(LeftSide% + 1) = 0 THEN        'Don't print blank pages
       GOTO NextPage1
    END IF
    CALL DoMacro("1")                           'Reset margins for left side
    LJLocate 0, 0                               'Home the cursor
    IF PC.DoHeader THEN CALL Header(LeftSide%)  'Header if needed
    Buffer$ = SPACE$(PtrArray&(LeftSide% + 1) - PtrArray&(LeftSide%))                'Setup buffer for input
    IF LeftSide% = 0 THEN                       'If pointing at blank page, skip
       GOTO NextPage1
    END IF
    GET #1, PtrArray&(LeftSide%), Buffer$       'Read in a page

    IF INSTR(Buffer$, FF$) THEN                 'if the last character is a PF
       PRINT #2, LEFT$(Buffer$, INSTR(Buffer$, FF$) - 1); 'print only text
    ELSE                                        'print only text
       PRINT #2, Buffer$;                       'otherwise print all
    END IF

NextPage1:
    PRINT #2, FF$;                              'Page feed
    LeftSide% = LeftSide - 2                    'Calculate next page in series
    RightSide% = RightSide + 2
    Bookmark% = Bookmark% - 1                   'Track our progress

LOOP UNTIL Bookmark% = 0                        'Print pages until halfway through

'============== Pause between sides
    IF FirstPass THEN                           'If side one, prompt and get 2nd side
       LOCATE , 1
       PRINT "Insert paper back in tray and press Enter"
       IF Tune% THEN BEEP

WaitKey:                                        'Press any key to continue loop
    A$ = ""                                     'Set A$ = Null string - 0 length
      DO
        A$ = INKEY$                             'Get a key if one is pending
      LOOP UNTIL LEN(A$)                        'Integer compares faster than strings
      IF ASC(A$) = 27 THEN GOTO PrtReset        'ESC key, takes you out
      IF ASC(A$) <> 13 THEN GOTO WaitKey        'Enter key only to prevent accidentally
                                                ' starting printer
      FirstPass = 0                             'Flag for second pass
      PRINT
      PRINT "Printing Side 2 to "; OutFile$;    'Report on progress
      GOTO DoPass
    END IF                                      'End of first pass

    LOCATE , 1                                  'Printing is done now
    PRINT "Printing completed "; SPACE$(60)
    IF Tune% THEN BEEP

PrtReset:
    PRINT #2, ESC$; "E";                        'Reset laserjet

OutHere:
    CLOSE                                       'Close all files
END                                             'Thats all for now

'============== Error handler
ErrorDept:
       PRINT
       PRINT "*** Error ***"
       BEEP
   SELECT CASE ERR
      CASE 24
         PRINT ERDEV$; " timed out"
      CASE 25                                   'Device fault
         PRINT "Device Fault on "; ERDEV$
      CASE 27                                   'Paper is out
         PRINT "Out of paper on "; ERDEV$
      CASE 53                                   'Source file not there
         PRINT "File "; FileName$; " not found"
         FileName$ = ""
         GOSUB AWayOut
         RESUME GetName
      CASE 71                                   'Open drive door
         PRINT "Disk drive "; ERDEV$; " not ready"
      CASE ELSE
         PRINT "Error number "; ERR
         IF LEN(ERDEV$) THEN PRINT ERDEV$
    END SELECT
         GOSUB AWayOut
         RESUME

AWayOut:
   PRINT
   PRINT "Press any key to try again"
   PRINT "Or ESC to quit"
   PRINT

KeyIn:                                          'Wait on error for a key
   A$ = ""
   DO
      A$ = INKEY$
   LOOP UNTIL LEN(A$)
      IF ASC(A$) = 27 THEN                      'Exit out if ESC is pressed
         CLOSE
         END
      END IF
RETURN

'============================ End of main module ============================

SUB BuildArray (PtrArray&(), Pgcount%) STATIC
   'FileName$ is shared from the main module

   MaxLines% = 66                               'Maximum number of lines
   Offset& = 1                                  'Start of file (seek point)
   OPEN FileName$ FOR BINARY AS #1 LEN = 1      'Open file to check
   TotalSize& = LOF(1)                          'Get LEN of file so we don't read too far
   FileLeft& = TotalSize&                       'Setup a counter to show whats left
   MemAvail& = FRE(FileName$) - 2048            'Check available string memory
   IF MemAvail& < 2048 THEN ERROR 14            'Force out of memory error
   SixteenK% = 16384

   IF TotalSize& > SixteenK% THEN               'Set a buffer size
      IF MemAvail& > SixteenK% THEN             'If the file is larger than 16K
         BufSize& = SixteenK%                   'Set it to 16k
      ELSE
         BufSize% = MemAvail&
      END IF
   ELSE
      IF TotalSize& < MemAvail& THEN            'Otherwise set it to file size
         BufSize& = TotalSize&
      END IF
   END IF

   Pgcount% = 1                                 'Initialize page count
   PtrArray&(Pgcount%) = 1                      'First pointer is always 1
   LnCount% = 0                                 'Initialize line count

GetPage:
                                                'Read the file
  IF FileLeft& < BufSize& THEN                  'Check amount left to read
     Buffer$ = SPACE$(FileLeft&)                'If less than our buffer, use lessor
  ELSE
     Buffer$ = SPACE$(BufSize&)                 'Otherwise use full buffer size
  END IF

  GET #1, Offset&, Buffer$                      'Read in a buffers worth
  StPtr% = 1                                    'Pointer into buffer$
  LastLine% = 0                                 'remember last position

PageCheck:
  TempLn% = INSTR(StPtr%, Buffer$, LF$)         'Position of next linefeed
  TempPg% = INSTR(StPtr%, Buffer$, FF$)         'Position of next pagefeeds

  IF TempPg% THEN                               'If there was a page feed
     IF TempPg% < TempLn% OR TempLn% = 0 THEN   '  was it before our linefeed?
        Pgcount% = Pgcount% + 1                 '  yes then bump page count
        PtrArray&(Pgcount%) = Offset& + TempPg% '  set next array element
        StPtr% = TempPg% + 1                    '  set instr pointer
        LnCount% = 0                            '  reset linecount
        IF StPtr% < LEN(Buffer$) THEN GOTO PageCheck 'and loop back for more
      END IF
  END IF

  IF TempLn% THEN                               'Linefeed
     IF PC.LineWrap THEN                        'If /W the check line length
        IF TempLn% - StPtr% > PC.LineLen THEN   'Greater than 80?
           DO                                   'check for line wrap
             LnCount% = LnCount% + 1            'increment line
             IF LnCount% = MaxLines THEN GOTO PageBreak  '> 66 lines
             StPtr% = StPtr% + PC.LineLen
           LOOP WHILE TempLn% - StPtr% > PC.LineLen
        END IF
     END IF
     LnCount% = LnCount% + 1                    'Increment page count

PageBreak:
     IF LnCount% = MaxLines% THEN
         Pgcount% = Pgcount% + 1
            IF Pgcount% > 512 THEN
               PRINT "Too may pages- printing only 512"
               GOTO EndBuild
            END IF
         PtrArray&(Pgcount%) = Offset& + TempLn% 'point to next in point in file
         LnCount% = 0
     END IF
     StPtr% = TempLn% + 1                       'point ahead 1 byte for next scan

     IF StPtr% <= LEN(Buffer$) THEN
        GOTO PageCheck                          'keep checking
     END IF
  END IF

  Offset& = Offset& + LEN(Buffer$)              'Pointer into file (tally)
  StPtr% = 1                                    'Reset Buffer pointer
  FileLeft& = TotalSize& - Offset&              'Calculate how much is left
  IF Offset& < TotalSize& THEN GOTO GetPage     'If more text in file, keep going

EndBuild:
  PtrArray&(Pgcount% + 1) = TotalSize&          'Set last pointer to end of file

CLOSE #1                                        'Close input file

END SUB                                         'End of BuildArray Module

SUB DoMacro (Num$) STATIC
    PRINT #2, ESC$; "&f"; Num$; "y2X";          'execute the macro
END SUB

SUB EndMacro (Num$) STATIC
    PRINT #2, ESC$; "&f"; Num$; "y1X";          'Send end of macro command
    PRINT #2, ESC$; "&f"; Num$; "y9X";          'Make it temporary (10 to be permanent)
END SUB

SUB Header (Page%) STATIC
   Hdr$ = SPACE$(PC.LineLen)                    'Create a string to print
   IF PC.FileTitle THEN                         'Print the filename
      MID$(Hdr$, 40 - LEN(FileName$) \ 2) = UCASE$(FileName$)
   END IF

   IF PC.PgNumber THEN                          'Print the current page
     PTemp$ = "Page" + STR$(Page%)
     IF Page% MOD 2 THEN
        MID$(Hdr$, PC.LineLen - LEN(PTemp$)) = PTemp$ 'odd page, right side
     ELSE
        MID$(Hdr$, 1) = PTemp$                  'even page, left side
     END IF
   END IF

   IF PC.CurDate THEN                           'Print the current date
     IF Page% MOD 2 THEN
        MID$(Hdr$, 1) = DATE$                   'even page, left side
     ELSE
         MID$(Hdr$, PC.LineLen - LEN(DATE$)) = DATE$ 'odd page, right side
     END IF
   END IF
   PRINT #2, Hdr$                               'Print the Header
   PRINT #2,                                    ' and skip a line for readability

END SUB

SUB LJLocate (X%, Y%) STATIC                    'Laser Jet cursor locate
    Temp$ = ESC$ + "&a" + LTRIM$(STR$(Y%)) + "r" + LTRIM$(STR$(X%)) + "C"
    PRINT #2, Temp$;
END SUB

SUB PrintLogo STATIC                            'Banner logo
PRINT STRING$(80, 61)
PRINT "PCBook - PC Magazine Booklet Printing Utility"
PRINT "Copyright 1990 PC Magazine  Ziff Davis  Jay Munro"
PRINT STRING$(80, 61)
END SUB

SUB PrintSetup                  '============== Send codes to prepare printer
    PRINT #2, ESC$; "E";                        'Reset laserjet (simple isn't it!)
    PRINT #2, ESC$; "&l1o5.45C";                'Select lineprinter font"
    PRINT #2, ESC$; "(s0p16.66H";               '  and pitch
    PRINT #2, ESC$; "&l0L";                     'Turn off page feed at 66 lines

    IF PC.LineWrap THEN                         'Wrap lines > 80 chars
       PRINT #2, ESC$; "&s0C";
    END IF

    PRINT #2, ESC$; "&l2E";                     'Top margin 2 lines

    CALL StartMacro("1")                        'Left side macro
         PRINT #2, ESC$; "9";                   'Reset left - right margins
         PRINT #2, ESC$; "&a0l80M";             'set left margin 0, right 80
    CALL EndMacro("1")

    CALL StartMacro("2")                        'Right side macro
         PRINT #2, ESC$; "9";                   'Reset left - right margins
         PRINT #2, ESC$; "&a95l175M";           'set left margin 95, right 175
    CALL EndMacro("2")

END SUB

SUB StartMacro (Num$) STATIC
    PRINT #2, ESC$; "&f"; Num$; "Y";            'Macro will have an id of Num$
    PRINT #2, ESC$; "&f0X";                     'Start the macro now
END SUB